##############################################################################
#
# Exceptions.pm
# ==============
#
# Author: Steven Liang <stliang@gmail.com>
#
# Purpose:
#   Exceptions is a composite of various exceptions classes
#   created just for PAT
#
# Assumptions:
#   1.) The Exception::Class module is installed
#
# Reference:
#   http://search.cpan.org/~drolsky/Exception-Class-1.20/lib/Exception/Class.pm
#   http://axkit.org/docs/presentations/tpc2002/exceptions.pdf
#   http://search.cpan.org/src/DROLSKY/Alzabo-0.86/lib/Alzabo/Exceptions.pm
#
##############################################################################

package AutoTest::Exceptions;

use strict;
use vars qw($VERSION);

$VERSION = 1.01;

my %e;

BEGIN
{
    %e = ( 'AutoTest::Exception' =>
           { description =>
             'Generic exception within the AutoTest::Exception API.  Should only be used as a base class.',
             alias => 'exception',
           },

           'AutoTest::Exception::Environment' =>
           { description => 'System environment is not ready for auto test',
             isa => 'AutoTest::Exception',
             alias => 'environment_exception',
           },

           'AutoTest::Exception::Connection' =>
           { description =>
             'An attempt to open communication channel failed',
             isa => 'AutoTest::Exception',
             alias => 'connection_exception',
           },

           'AutoTest::Exception::Expect' =>
           { description => 'Send expect interaction failed',
             isa => 'AutoTest::Exception',
             alias => 'expect_exception',
           },

           'AutoTest::Exception::Panic' =>
           { description => 'An exception generated when something totally unexpected happens',
             isa => 'AutoTest::Exception',
             alias => 'panic_exception',
           },

           'AutoTest::Exception::Params' =>
           { description => 'An error in the parameters passed in a method of function call',
             isa => 'AutoTest::Exception',
             alias => 'params_exception',
           },

         );
}

use Exception::Class (%e);

AutoTest::Exception->Trace(1);

sub isa_AutoTest_Exception
{
    my ($err, $name) = @_;
    return unless defined $err;

    if ($name)
    {
        my $class = "AutoTest::Exception::$name";

        {
            no strict 'refs';
            die "no such exception class $class"
                unless defined(${"${class}::VERSION"});
        }

        return UNIVERSAL::isa($err, $class);
    }
    else
    {
        return UNIVERSAL::isa($err, "AutoTest::Exception");
    }
}

sub rethrow_exception
{
    my $err = shift;

    return unless $err;

    if ( UNIVERSAL::can( $err, 'rethrow' ) )
    {
        $err->rethrow;
    }
    elsif ( ref $err )
    {
        die $err;
    }
    AutoTest::Exception->throw( error => $err );
}

package AutoTest::Exception;

sub format
{
    my $self = shift;

    if (@_)
    {
        $self->{format} = shift eq 'html' ? 'html' : 'text';
    }

    return $self->{format} || 'text';
}

sub as_string
{
    my $self = shift;

    my $stringify_function = "as_" . $self->format;

    return $self->$stringify_function();
}

sub as_text
{
    return $_[0]->full_message . "\n\n" . $_[0]->trace->as_string;
}

sub as_html
{
    my $self = shift;

    my $msg = $self->full_message;

    require HTML::Entities;
    $msg = HTML::Entities::encode_entities($msg);
    $msg =~ s/\n/<br>/;

    my $html = <<"EOF";
<html><body>
<p align="center"><font face="Verdana, Arial, Helvetica, sans-serif"><b>System error</b></font></p>
<table border="0" cellspacing="0" cellpadding="1">
 <tr>
  <td nowrap align="left" valign="top"><b>error:</b>&nbsp;</td>
  <td align="left" valign="top" nowrap>$msg</td>
 </tr>
 <tr>
  <td align="left" valign="top" nowrap><b>code stack:</b>&nbsp;</td>
  <td align="left" valign="top" nowrap>
EOF

    foreach my $frame ( $self->trace->frames )
    {
        my $filename = HTML::Entities::encode_entities( $frame->filename );
        my $line = $frame->line;

        $html .= "$filename: $line<br>\n";
    }

    $html .= <<'EOF';
  </td>
 </tr>
</table>

</body></html>
EOF

    return $html;
}

1;

